home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-20 / minimuf3.zip / MINIMUF.PAS < prev    next >
Pascal/Delphi Source File  |  1990-10-14  |  28KB  |  913 lines
  1. PROGRAM Minimuf_CalculateTheMuf;
  2. {
  3. This program calculates and displays on the screen MUF information, hour-
  4. by-hour (GMT), for one path.  A graph is drawn.  After displaying the MUF
  5. information on the screen, a hard copy can be printed.
  6.  
  7. The program is set to print MUF values from a QTH in Dallas, Texas.
  8. The program can be customized to any QTH and the 15 pre-programmed path
  9. choices can be modified by changing the setup file MUFSETUP.DAT.
  10.  
  11. This program is based on a BASIC program originally published in QEX of
  12. November, 1983.  The QEX program was an adaptation to the IBM PC BASIC
  13. by John E. Anderson WD4MUO of a BASIC program published in QST of
  14. December, 1982.
  15.  
  16. This program was adapted to TurboPascal by Keith Seabourn, 5N6SKD from
  17. these BASIC programs found in QEX and QST.  The adaptation to Pascal is
  18. not a particularly good example of Pascal coding technique.  The procedure
  19. MinimufCalcLoop was taken directly from BASIC to Pascal and includes the
  20. limitations of BASIC, including brief variable names and GOTO statements.
  21.  
  22. Source:  QEX November, 1983 and QST December 1982, page 38.
  23. Source of Polynomial flux to sunspot number conversion:  Gilder, James H.;
  24.   Basic Computer Programs in Science and Engineering; Hayden 1980.
  25. }
  26.  
  27. CONST
  28.    Mstr : array[1..12] of string[3] = ('JAN','FEB','MAR','APR','MAY',
  29.             'JUN','JUL','AUG','SEP','OCT','NOV','DEC');
  30.    M : array[1..12] of integer = (31,29,31,30,31,30,31,31,30,31,30,31);
  31.    PI = 3.141593;
  32.    Xstr = '===============================================================================';
  33.    Spaces = '                                                                                ;';
  34.    Yes : set of char = ['Y','y'];
  35.    No : set of char = ['N','n'];
  36.    MinMuf : integer = 7;
  37.    MaxMuf : integer = 28;
  38.    MaxPathLength = 24;
  39.  
  40. TYPE
  41.   FileNameType = string[14];
  42.   Long_String = string[255];
  43.  
  44. VAR
  45.    L1, L2, W1, W2, R0, R1, P0, P1, SF, S9, Tam, J9 : REAL;
  46.    TLat, TLon, RLat, RLon : REAL;
  47.    Ch, M0, D6, LP, TA, I, T5 : INTEGER;
  48.    Title, Line : STRING [80];
  49.    Tstr, Rstr : STRING [32];
  50.    T1, T2, X : INTEGER;
  51.    ANstr, AN1str, TAstr, Dstr : CHAR;
  52.    Plot : ARRAY [0..23, 7..28] of CHAR;
  53.    Muf : ARRAY [0..23] of REAL;
  54.    XPos, YPos : BYTE;
  55.    Path : array [1..15] of string[24];
  56.    Lat,
  57.    Lon : array [1..15] of real;
  58.    StationCall : string [11];
  59.    StationLat,
  60.    StationLon : real;
  61.    SetupFile : Text;
  62.    MaxChoices : byte;
  63.    SetupFileError : boolean;
  64.    Cntr : integer;
  65.    CSstr : string[11];
  66.  
  67. {$U+}
  68.  
  69.  
  70. FUNCTION Fnacs (X : REAL) : REAL;
  71.    BEGIN
  72.       Fnacs := -ARCTAN (X / SQRT(-X * X + 1)) + 1.5708
  73.    END;
  74.  
  75.  
  76. {*****************************************************************************}
  77. {This function checks for the existence of a file of the name passed to it
  78. by attempting to reset the file with I/O error checking switched off, and
  79. then looking at IOResult, the built-in variable that holds I/O error
  80. messages.  This function will NOT check for files in any but the current
  81. directory--use the "Find_First" function in GETFILE.LIB for those.
  82.  
  83. function EXISTS: boolean;
  84.   input : a filename of a TYPE declared in user program (BEFORE including this
  85.               file!)
  86.   output: true if exists else false.}
  87.  
  88.  
  89. function exists(ThisFile : FileNameType):boolean;
  90. var
  91.   tempFile : text;  {We can get away with assigning a text file to ANY
  92.                      filename because we aren't going to do any input/output}
  93. begin
  94.   assign(tempFile,ThisFile);
  95.   {$I-}
  96.   reset(tempFile);
  97.   {$I+}
  98.   if IOResult = 0 then exists := true
  99.     else exists := false;
  100.   close(tempFile);
  101. end;
  102.  
  103.  
  104. {****************************************************************************}
  105. Procedure Alert(Message : Long_String);{* This routine prints MESSAGE to the*}
  106.                                        {* screen and makes an obnoxious     *}
  107. Var                                    {* noise for about 1 second          *}
  108.   I : Integer;                         {*************************************}
  109.   i1,i2,i3,i4 : integer;
  110.  
  111.  
  112. begin
  113.   write(Message);
  114.   for i4 := 10 downto 1 do
  115.     begin
  116.     i2 := 250 + i4 * 25;
  117.     for i3 := 2 downto 1 do
  118.       begin
  119.       for i1 := 1 to 30 - i3 * 2 do
  120.         begin
  121.         sound(i1 + i2 + i3 * 2);
  122.         delay(2);
  123.         end;
  124.       delay(5);
  125.       i2 := i2 + 30;
  126.       end;
  127.     nosound;
  128.     end;
  129. end;
  130.  
  131.  
  132. PROCEDURE Initialize;
  133.    BEGIN
  134.       R0 := PI / 180.0;
  135.       P1 := 2.0 * PI;
  136.       R1 := 180.0 / PI;
  137.       P0 := PI / 2.0;
  138.       TITLE := COPY(Spaces,1,36) + 'MINIMUF' + COPY(Spaces,1,36);
  139.       AN1str := '*';
  140.    END;
  141.  
  142.  
  143.  
  144. PROCEDURE ReadSetupFileData;
  145. {Reads the file MUFSETUP.DAT on the default drive.  Returns
  146.   StationCall : string[11] : callsign of station
  147.   StationLat,
  148.   StationLon  : real : latitude, longitude for station
  149.   Path : array [1..15] of string[24] : path options
  150.   Lat  : array [1..15] of real : latitude for each path option
  151.   Lon  : array [1..15] of real : longitude for each path option
  152.   SetupFileError : boolean : TRUE if an error is found in the file
  153.                              FALSE if data is good
  154. }
  155.  
  156. var
  157.   OneChar : char;
  158.   LatStr,
  159.   LonStr : string[7];
  160.   ConvError : integer;
  161.   I, J : integer;
  162.  
  163. begin
  164.   SetupFileError := False;
  165.   assign(SetupFile,'MUFSETUP.DAT');
  166.   if exists('MUFSETUP.DAT') then
  167.     begin
  168.       reset(SetupFile);
  169.       {Get station call, station latitude, station longitude}
  170.       StationCall := '';
  171.       I := 1;
  172.       repeat
  173.         read(SetupFile,OneChar);
  174.         if OneChar<>';' then StationCall := StationCall + OneChar;
  175.         I := I + 1;
  176.       until ((OneChar=';') or (I>(SizeOf(StationCall)-1)) or (OneChar=^M));
  177.       if ((OneChar <> ';') or (I>(SizeOf(StationCall)-1)) or (OneChar=^M)) then
  178.         begin
  179.           SetupFileError := True;
  180.           writeln('An error occurred while reading setup file.');
  181.           writeln('The Station Call "',StationCall,'" is more than ',
  182.               (SizeOf(StationCall)-1):2,' characters');
  183.           writeln('or latitude or longitude data is missing.');
  184.           writeln;
  185.         end;
  186.  
  187.       {Parse for Latitude}
  188.       if not SetupFileError then
  189.         begin
  190.           I := 1;
  191.           LatStr := '';
  192.           repeat
  193.             read(SetupFile,OneChar);
  194.             if OneChar<>';' then LatStr := LatStr + OneChar;
  195.             I := I + 1;
  196.           until ((OneChar=';') or (I>(SizeOf(LatStr)-1)) or (OneChar=^M));
  197.           val(LatStr,StationLat,ConvError);
  198.           if (Length(LatStr)=0) or (OneChar<>';') or (I>(SizeOf(LatStr)-1))
  199.                   or (ConvError<>0) then
  200.             begin
  201.               SetupFileError := True;
  202.               writeln('An error occurred while reading setup file.');
  203.               writeln('The latitude "',LatStr,'" is not in the correct ',
  204.                   'format or has too many digits.');
  205.               writeln;
  206.             end;
  207.         end;
  208.  
  209.       {Parse for Longitude}
  210.       if not SetupFileError then
  211.         begin
  212.           I := 1;
  213.           LonStr := '';
  214.           repeat
  215.             read(SetupFile,OneChar);
  216.             if (OneChar<>';') and (OneChar<>^M) then LonStr := LonStr + OneChar;
  217.             I := I + 1;
  218.           until (OneChar=^M) or (I>(SizeOf(LonStr)-1));
  219.           val(LonStr,StationLon,ConvError);
  220.           if ((Length(LonStr)=0) or (I>(SizeOf(LonStr)-1)) or (ConvError<>0)) then
  221.             begin
  222.               SetupFileError := True;
  223.               writeln('An error occurred while reading setup file.');
  224.               writeln('The longitude "',LonStr,'" is not in the correct ',
  225.                   'format or has too many digits.');
  226.               writeln;
  227.            end;
  228.         end;
  229.       read(SetupFile,OneChar); {skip the Line Feed}
  230.  
  231.       {Read remainder of SetupFile and parse for path options}
  232.       I := 1;
  233.       while not (SetupFileError or EOF(SetupFile)) do
  234.         begin
  235.           Path[I] := '';
  236.           Lat[I] := 0.0;
  237.           Lon[I] := 0.0;
  238.           LatStr := '';
  239.           LonStr := '';
  240.           J := 0;
  241.  
  242.           repeat
  243.             J := J + 1;
  244.             read(SetupFile,OneChar);
  245.             if OneChar<>';' then Path[I] := Path[I] + OneChar;
  246.           until (OneChar=';') or (J>MaxPathLength+1) or (OneChar = ^M);
  247.           if (OneChar <> ';') or (J>MaxPathLength+1) then
  248.             begin
  249.               SetupFileError := True;
  250.               if (J > MaxPathLength) or (OneChar = ^M) then
  251.                 begin
  252.                   writeln('An error occurred while reading setup file.');
  253.                   writeln('The path "',Path[I],'" is more than ',
  254.                       MaxPathLength:2,' characters');
  255.                   writeln('or latitude or longitude data is missing.');
  256.                   writeln;
  257.                 end;
  258.             end;
  259.  
  260.           if not SetupFileError then
  261.             begin
  262.               J := 1;
  263.               repeat
  264.                 read(SetupFile,OneChar);
  265.                 if (OneChar<>';') and (OneChar<>^M) then LatStr := LatStr + OneChar;
  266.                 J := J + 1;
  267.               until (OneChar=';') or (J>(SizeOf(LatStr)-1)) or (OneChar=^M);
  268.               val(LatStr,Lat[I],ConvError);
  269.  
  270.               if (Length(LatStr)<=0) or (OneChar<>';') or (J>(SizeOf(LatStr)-1))
  271.                     or (ConvError<>0) then
  272.                 begin
  273.                   SetupFileError := True;
  274.                   writeln('An error occurred while reading setup file.');
  275.                   writeln('The latitude "',LatStr,'" in the path "',Path[I],'"');
  276.                   writeln('is not in the correct format or has too many digits.');
  277.                   writeln;
  278.                 end;
  279.             end;
  280.  
  281.           if not SetupFileError then
  282.             begin
  283.               J := 1;
  284.               repeat
  285.                 read(SetupFile,OneChar);
  286.                 if (OneChar<>';') and (OneChar<>^M) then LonStr := LonStr + OneChar;
  287.                 J := J + 1;
  288.               until (OneChar=^M) or (J>(SizeOf(LonStr))) or (EOF(SetupFile));
  289.               val(LonStr,Lon[I],ConvError);
  290.               if (Length(LonStr) <=0) or (J > (SizeOf(LonStr)))
  291.                       or (ConvError <> 0) then
  292.                 begin
  293.                   SetupFileError := True;
  294.                   writeln('An error occurred while reading setup file.');
  295.                   writeln('The longitude "',LonStr,'" in the path "',Path[I],'"');
  296.                   writeln('is not in the correct format or has too many digits.');
  297.                   writeln;
  298.                 end;
  299.             end;
  300.  
  301.           I := I + 1;
  302.           read(SetupFile,OneChar);  {skip LineFeed}
  303.         end;  {while not(SetupFileError or EOF(SetupFile)}
  304.  
  305.       if SetupFileError then
  306.         begin
  307.           gotoxy(1,WhereY+1);
  308.           alert('An error occurred while reading setup file.');
  309.           writeln;
  310.           writeln('Use an ASCII word processor to carefully check the file');
  311.           writeln('MUFSETUP.DAT then try again.');
  312.           write('Press any key to continue...');
  313.           repeat until keypressed;
  314.  
  315.           MaxChoices := 0;
  316.         end
  317.       else
  318.         MaxChoices := I - 1;
  319.     end  {if SetupFile exists}
  320.   else    {if SetupFile does not exist}
  321.     begin
  322.       alert('MUFSETUP.DAT cannot be found. Program aborting.');
  323.     end;
  324. end;  {procedure ReadSetupFileData}
  325.  
  326.  
  327. PROCEDURE PrintScreenHeader;
  328.    BEGIN
  329.       CLRSCR;
  330.       TEXTCOLOR(Black);
  331.       TEXTBACKGROUND(LightGray);
  332.       WRITELN (Xstr);
  333.       WRITELN (TITLE);
  334.       WRITELN (Xstr);
  335.       TEXTCOLOR(LightGray);
  336.       TEXTBACKGROUND(Black);
  337.    END;
  338.  
  339.  
  340.  
  341. PROCEDURE DisplayOptionMenu;
  342.    BEGIN
  343.       WRITELN;
  344.       WRITELN ('Path Options');
  345.       WRITELN;
  346.       FOR I := 1 TO MaxChoices do
  347.          WRITELN(I:3,' ',CSstr,' ',Path[I]);
  348.       WRITELN (' 16 ', CSstr, ' TO A SPECIFIED POINT');
  349.       WRITELN (' 17 ','BETWEEN SPECIFIED POINTS');
  350.    END;
  351.  
  352.  
  353. PROCEDURE GetTransmitterLatLon;
  354.    BEGIN
  355.       REPEAT
  356.          WRITELN;
  357.          WRITE ('TRANSMITTER LATITUDE ("-" for East)?');
  358.          READLN (L1);
  359.          IF (L1 < -90.0) OR (L1 > 90.0) THEN
  360.                WRITELN ('INVALID LATITUDE.  MUST BE IN RANGE (-90 TO +90).');
  361.       UNTIL (L1 >= -90.0) AND (L1 <= 90.0);
  362.  
  363.       REPEAT
  364.          WRITE ('TRANSMITTER LONGITUDE ("-" for South)?');
  365.          READLN (W1);
  366.          IF (W1 < -360.0) OR (W1 > 360.0) THEN
  367.                WRITELN ('INVALID LONGITUDE.  MUST BE IN RANGE (-360 TO +360).');
  368.       UNTIL (W1 >= -360.0) AND (W1 <= 360.0);
  369.    END;   {Procedure GetTransmitterLatLon}
  370.  
  371.  
  372.  
  373. PROCEDURE GetReceiverLatLon;
  374.    BEGIN
  375.       REPEAT
  376.          WRITELN;
  377.          WRITE ('RECEIVER LATITUDE ("-" for East)?');
  378.          READLN (L2);
  379.          IF (L2 < -90.0) OR (L2 > 90.0) THEN
  380.                WRITELN ('INVALID LATITUDE.  MUST BE IN RANGE (-90 TO +90).');
  381.       UNTIL (L2 >= -90.0) AND (L2 <= 90.0);
  382.  
  383.       REPEAT
  384.          WRITE ('RECEIVER LONGITUDE ("-" for South)?');
  385.          READLN (W2);
  386.          IF (W2 < -360.0) OR (W2 > 360.0) THEN
  387.                WRITELN ('INVALID LONGITUDE.  MUST BE IN RANGE (-360 TO +360).');
  388.       UNTIL (W2 >= -360.0) AND (W2 <= 360.0);
  389.    END;   {Procedure GetReceiverLatLon}
  390.  
  391.  
  392.  
  393. PROCEDURE GetLatitudeLongitude;
  394.    BEGIN
  395.       Tstr := CSstr;
  396.  
  397.       CASE Ch OF
  398.          1..15 : BEGIN
  399.                     L1 := StationLat;
  400.                     W1 := StationLon;
  401.                     L2 := Lat[Ch];
  402.                     W2 := Lon[Ch];
  403.                     Rstr := Path[Ch];
  404.                  END;
  405.  
  406.              16: BEGIN
  407.                     L1 := StationLat;
  408.                     W1 := StationLon;
  409.                     Rstr := 'RECEIVER';
  410.                     GetReceiverLatLon;
  411.                  END;
  412.  
  413.              17: BEGIN
  414.                     Tstr := 'TRANSMITTER';
  415.                     Rstr := 'RECEIVER';
  416.                     GetTransmitterLatLon;
  417.                     GetReceiverLatLon;
  418.                  END;
  419.       END;  {Case}
  420.    TLat := L1;
  421.    TLon := W1;
  422.    RLat := L2;
  423.    RLon := W2;
  424. END;   {Procedure GetLatitudeLongitude}
  425.  
  426.  
  427. PROCEDURE GetDayMonth;
  428. BEGIN
  429.    REPEAT
  430.       WRITELN;
  431.       WRITELN ('Input day and month as (day month)? ');
  432.       READLN (D6,M0);
  433.       IF (M0<1) OR (M0>12) THEN WRITELN ('Invalid Month.  Must be in range (1 to 12)');
  434.       IF (D6<1) OR (D6>M[M0]) THEN WRITELN ('Invalid Day.  Must be in range (1 to ', M[M0], ')');
  435.    UNTIL (M0>=1) AND (M0<=12) AND (D6>=1) AND (D6<=M[M0]);
  436. END;
  437.  
  438.  
  439. PROCEDURE SolarFluxToSunSpot;
  440. BEGIN
  441.    S9 := -103.7767 + 1.797429 * SF - (3.384356E-03)*SF*SF + (4.525515E-06)*SF*SF*SF;
  442.    S9 := INT (100 * S9 +0.5)/100;
  443. END;
  444.  
  445.  
  446. PROCEDURE SunSpotData;
  447. BEGIN
  448.    WRITELN;
  449.    WRITE ('STATE SOURCE OF SOLAR ACTIVITY - S=sunspot no.  F=solar flux ? ');
  450.    READLN (AN1str);
  451.    IF (AN1str='S') OR (AN1str='s') THEN
  452.    BEGIN
  453.       REPEAT
  454.          WRITELN;
  455.          WRITE ('INPUT SMOOTHED INTERNATIONAL SUNSPOT NUMBER= ? ');
  456.          READLN (S9);
  457.          IF S9<0 THEN WRITELN ('INVALID SUNSPOT NUMBER.  MUST BE NON-NEGATIVE.');
  458.       UNTIL (S9 >= 0.0);
  459.       END
  460.  
  461.    ELSE
  462.    BEGIN
  463.       REPEAT
  464.          WRITE ('INPUT SMOOTHED MEAN 10.7cm SOLAR FLUX ? ');
  465.          READLN (SF);
  466.          IF (SF<65) THEN WRITELN ('INVALID FLUX NUMBER, MUST BE GREATER THAN 65.');
  467.          IF (SF>245) THEN WRITELN ('RESULTS MAY BE INACCURATE FOR FLUX GREATER THAN 245.');
  468.       UNTIL SF>=65;
  469.       SolarFluxToSunSpot;
  470.       WRITELN ('A FLUX OF ', SF:5:1, ' EQUATES TO A SUNSPOT NUMBER OF ', S9:3:0);
  471.       END;
  472. END;   {Procedure SunSpotData}
  473.  
  474.  
  475. PROCEDURE HardCopyFlag;
  476. BEGIN
  477. TEXTBACKGROUND(LightGray);
  478. TEXTCOLOR(Black);
  479.    REPEAT
  480.       WRITE ('Want Printout(Y/N)?',^G,^G,^G);
  481.       TEXTBACKGROUND(Black);
  482.       TEXTCOLOR(LightGray);
  483.       WRITE (' ');
  484.       READ (ANstr);
  485.       IF (ANstr IN Yes) THEN LP := 1;
  486.       IF (ANstr IN No)  THEN LP := 0;
  487.    UNTIL (ANstr IN Yes) OR (ANstr IN No);
  488. END;   {Procedure HardCopyFlag}
  489.  
  490.  
  491. PROCEDURE ThresholdFlag;
  492. BEGIN
  493.    REPEAT
  494.       WRITELN;
  495.       WRITELN;
  496.       WRITE ('WANT FLAG ON MUF ABOVE GIVEN FREQ (Y or N)? ');
  497.       READLN (TAstr);
  498.       IF (TAstr IN Yes) THEN
  499.       BEGIN
  500.          TA:=1;
  501.          WRITE ('SPECIFY FREQ IN MHZ.? ');
  502.          READLN (Tam);
  503.          END;
  504.       IF (TAstr IN No) THEN TA:=0;
  505.    UNTIL (TAstr IN Yes) OR (TAstr IN No);
  506. END;
  507.  
  508.  
  509. PROCEDURE HardCopyHeader;
  510. BEGIN
  511.    WRITELN(LST,'      1   3   5   7   9  11  13  15  17  19  21  23');
  512. END;
  513.  
  514.  
  515. PROCEDURE HardCopyFooter;
  516. BEGIN
  517.    WRITELN(LST,'      1   3   5   7   9  11  13  15  17  19  21  23   ');
  518. END;
  519.  
  520.  
  521. PROCEDURE HardCopyDataPrint;
  522.    BEGIN
  523.  
  524.    T5 := MaxMuf;
  525.    WRITE(LST,T5:2, '|');
  526.    FOR I:=0 TO 23 DO WRITE(LST,' ', Plot[I,T5]);
  527.    WRITELN(LST,'   Date: ', D6:2, ' ', Mstr[M0]);
  528.  
  529.    T5 := T5 - 1;
  530.    WRITE(LST,T5:2, '|');
  531.    FOR I := 0 TO 23 DO WRITE(LST,' ', Plot[I,T5]);
  532.    WRITELN(LST);
  533.  
  534.    T5 := T5 - 1;
  535.    WRITE(LST,T5:2, '|');
  536.    FOR I := 0 TO 23 DO WRITE(LST,' ', Plot[I,T5]);
  537.    WRITELN(LST,'Sunspot Number = ', S9:3:0);
  538.  
  539.    T5 := T5 - 1;
  540.    WRITE(LST,T5:2, '|');
  541.    FOR I := 0 TO 23 DO WRITE(LST,' ', Plot[I,T5]);
  542.    WRITELN(LST);
  543.  
  544.    T5 := T5 - 1;
  545.    WRITE(LST,T5:2, '|');
  546.    FOR I := 0 TO 23 DO WRITE(LST,' ', Plot[I,T5]);
  547.    WRITELN(LST,'From: ', COPY(Tstr, 1, 22));
  548.  
  549.    T5 := T5 - 1;
  550.    WRITE(LST,T5:2, '|');
  551.    FOR I := 0 TO 23 DO WRITE(LST,' ', Plot[I,T5]);
  552.    WRITELN(LST,'      Lat: ', TLat:3:0, ' Lon: ',TLon:4:0);
  553.  
  554.  
  555.    T5 := T5 - 1;
  556.    WRITE(LST,T5:2, '|');
  557.    FOR I := 0 TO 23 DO WRITE(LST,' ', Plot[I,T5]);
  558.    WRITELN(LST,'To: ', COPY(Rstr, 1, 24));
  559.  
  560.    T5 := T5 - 1;
  561.    WRITE(LST,T5:2, '|');
  562.    FOR I := 0 TO 23 DO WRITE(LST,' ', Plot[I,T5]);
  563.    WRITELN(LST,'      Lat: ', RLat:3:0, ' Lon: ', RLon:4:0);
  564.  
  565.    T5 := T5 - 1;
  566.    WRITE(LST,T5:2, '|');
  567.    FOR I := 0 TO 23 DO WRITE(LST,' ', Plot[I,T5]);
  568.    WRITELN(LST);
  569.  
  570.    T5 := T5 - 1;
  571.    WRITE(LST,T5:2, '|');
  572.    FOR I := 0 TO 23 DO WRITE(LST,' ', Plot[I,T5]);
  573.    WRITELN(LST,'   UTC    MUF   UTC    MUF');
  574.  
  575.    FOR T5 := MaxMuf-10 DOWNTO MinMuf DO
  576.       BEGIN
  577.       T1 := (MaxMuf-10) - T5;
  578.       T2 := T1 + 12;
  579.       WRITE(LST,T5:2,'|');
  580.       FOR I := 0 TO 23 DO WRITE(LST,' ',Plot[I,T5]);
  581.       WRITELN(LST,'    ',T1:2,'   ',Muf[T1]:4:1,'    ',T2:2,'   ',Muf[T2]:4:1);
  582.       END;  {T5 := MaxMuf-10 DOWNTO MinMuf-12}
  583.  
  584.    END;
  585.  
  586.  
  587. FUNCTION SGN(X : REAL) :REAL;
  588.    {Simulates BASIC function SGN}
  589.    BEGIN
  590.    IF X < 0.0 THEN SGN := -1.0;
  591.    IF X = 0.0 THEN SGN := 0.0;
  592.    IF X > 0.0 THEN SGN := 1.0;
  593.    END;
  594.  
  595.  
  596. FUNCTION POWER(X, Y : REAL) :REAL;
  597.    {Raises X to the Yth power}
  598.    {Simulates BASIC X^Y or FORTRAN X**Y}
  599.    BEGIN
  600.    POWER := EXP(Y * LN(X));
  601.    END;
  602.  
  603.  
  604. PROCEDURE MinimufCalcLoop;
  605. LABEL
  606.    Label198, Label214, Label215, Label223, Label228, Label234;
  607.  
  608. CONST
  609.    MIN_EXP = -88.02969;
  610.  
  611. VAR
  612.    K7, G1, K6, K5, P, Q, A, B, C, D, W0, L0 : REAL;
  613.    T6, Y1, Y2, K1, K8, K9, G0, M9, T, T4, C0, T9 : REAL;
  614.    G9, G8, U, G7, G2, U1, EXP_U, EXP_U1, EXP_K9A, EXP_K9B : REAL;
  615.  
  616. BEGIN
  617.    K7 := SIN(L1) * SIN(L2) + COS(L1) * COS(L2) * COS(W2-W1);
  618.    IF K7 < -1.0 THEN K7 := -1.0;
  619.    IF K7 > 1.0 THEN K7 := 1.0;
  620.    G1 := Fnacs(K7);
  621.    K6 := 1.59 * G1;
  622.    IF K6 < 1.0 THEN K6 := 1.0;
  623.    K5 := 1.0/K6;
  624.    J9 := 100.0;
  625.    K1 := 1.0/(2.0*K6);
  626.    WHILE (SGN(0.9999-1.0/K6)*K1) <= (SGN(0.9999-1.0/K6)*(1.0 - 1.0/(2.0*K6))) DO
  627.       BEGIN
  628.       IF K5 <> 1.0 THEN K5 := 0.5;
  629.       P := SIN(L2);
  630.       Q := COS(L2);
  631.       A := (SIN(L1) - P*COS(G1)) / (Q * SIN(G1));
  632.       B := G1 * K1;
  633.       C := P * COS(B) + Q * SIN(B) * A;
  634.       D := (COS(B) - C * P) / (Q * SQRT(1 - C*C));
  635.       IF D < -1.0 THEN D := -1.0;
  636.       IF D > 1.0 THEN D := 1.0;
  637.       D := Fnacs(D);
  638.       W0 := W2 + SGN(SIN(W1-W2))*D;
  639.       IF W0 < 0.0 THEN W0 := W0+P1;
  640.       IF W0 >= P1 THEN W0 := W0-P1;
  641.       IF C < -1.0 THEN C := -1.0;
  642.       IF C > 1.0 THEN C := 1.0;
  643.       L0 := P0 - Fnacs(C);
  644.       Y1 := 0.0172 * (10 + (M0-1)*30.4 + D6);
  645.       Y2 := 0.409 * COS(Y1);
  646.       K8 := 3.82*W0 + 12.0 + 0.13*(SIN(Y1) + 1.2*SIN(2*Y1));
  647.       K8 := K8 - 12*(1 + SGN(K8-24.0))*SGN(ABS(K8-24.0));
  648.       IF COS(L0+Y2) > -0.26 THEN GOTO Label198;
  649.       K9 := 0.0;
  650.       G0 := 0.0;
  651.       M9 := 2.5 * G1 * K5;
  652.       IF M9 > P0 THEN M9 := P0;
  653.       M9 := SIN(M9);
  654.       M9 := 1.0 + 2.5 * M9 * SQRT(M9);
  655.       GOTO Label223;
  656.  
  657.       Label198:
  658.       K9 := (-0.26 + SIN(Y2)*SIN(L0)) / (COS(Y2)*COS(L0) + 9.999999E-04);
  659.       K9 := 12.0 - ARCTAN(K9/SQRT(ABS(1.0 - K9*K9))) * 7.639437;
  660.       T := K8 - K9/2.0 + 12.0*(1-SGN(K8-K9/2))*SGN(ABS(K8-K9/2));
  661.       T4 := K8 + K9/2 - 12.0*(1+SGN(K8+K9/2-24.0))*SGN(ABS(K8+K9/2-24.0));
  662.       C0 := ABS(COS(L0+Y2));
  663.       T9 := 9.7 * POWER(C0,9.600001);
  664.       IF T9 < 0.1 THEN T9 := 0.1;
  665.       M9 := 2.5 * G1 * K5;
  666.       IF M9 > P0 THEN M9 := P0;
  667.       M9 := SIN(M9);
  668.       M9 := 1.0 + 2.5 * M9 * SQRT(M9);
  669.       IF T4 < T THEN GOTO Label214;
  670.       IF ((T5-T) * (T4-T5)) > 0.0 THEN GOTO Label215;
  671.       GOTO Label228;
  672.  
  673.       Label214:
  674.       IF ((T5-T4) * (T-T5)) > 0.0 THEN GOTO Label228;
  675.  
  676.       Label215:
  677.       T6 := T5 + 12.0*(1.0+SGN(T-T5))*SGN(ABS(T-T5));
  678.       G9 := PI*(T6-T)/K9;
  679.       G8 := PI*T9/K9;
  680.       U := (T-T6)/T9;
  681.       IF U >= MIN_EXP THEN EXP_U := EXP(U) ELSE EXP_U := 0.0;
  682.       IF (-K9/T9) >= MIN_EXP THEN EXP_K9A := EXP(-K9/T9) ELSE EXP_K9A := 0.0;
  683.       IF ((K9-24.0)/2.0) >= MIN_EXP THEN EXP_K9B := EXP((K9-24.0)/2.0) ELSE EXP_K9B := 0.0;
  684.       G0 := C0*(SIN(G9) + G8*(EXP_U-COS(G9)))/(1.0 + G8*G8);
  685.       G7 := C0 * (G8*(EXP_K9A+1.0)) * EXP_K9B / (1.0 + G8*G8);
  686.       IF G0 < G7 THEN G0 := G7;
  687.  
  688.       Label223:
  689.       G2 := (1.0+S9/250.0) * M9 * SQRT(6.0+58.0*SQRT(G0));
  690.       IF ((K9-24.0)/3.0) >= MIN_EXP THEN EXP_K9B := EXP((K9-24.0)/3.0) ELSE EXP_K9B := 0.0;
  691.       G2 := G2*(1.0-0.1*EXP_K9B);
  692.       G2 := G2*(1.0+(1.0-SGN(L1)*SGN(L2))*0.1);
  693.       G2 := G2*(1.0-0.1*(1.0+SGN(ABS(SIN(L0))-COS(L0))));
  694.       GOTO Label234;
  695.  
  696.       Label228:
  697.       T6 := T5 + 12.0*(1.0+SGN(T4-T5))*SGN(ABS(T4-T5));
  698.       G8 := PI*T9/K9;
  699.       U := (T4-T6)/2.0;
  700.       U1 := -K9/T9;
  701.       IF U >= MIN_EXP THEN EXP_U := EXP(U) ELSE EXP_U := 0.0;
  702.       IF U1 >= MIN_EXP THEN EXP_U1 := EXP(U1) ELSE EXP_U1 := 0.0;
  703.       G0 := C0*(G8*(EXP_U1+1.0))*EXP_U/(1.0 + G8*G8);
  704.       GOTO Label223;
  705.  
  706.       Label234:
  707.       IF G2 < J9 THEN J9 := G2;
  708.  
  709.       K1 := K1 + 0.9999-1.0/K6;
  710.       END;   {While}
  711.    END;  {Procedure}
  712.  
  713.  
  714. PROCEDURE DataPrint;
  715.    BEGIN
  716.  
  717.    T5 := MaxMuf;
  718.    WRITE(T5:2, '|');
  719.    FOR I:=0 TO 23 DO WRITE(' ', Plot[I,T5]);
  720.    WRITELN('   Date: ', D6:2, ' ', Mstr[M0]);
  721.  
  722.    T5 := T5 - 1;
  723.    WRITE(T5:2, '|');
  724.    FOR I := 0 TO 23 DO WRITE(' ', Plot[I,T5]);
  725.    WRITELN;
  726.  
  727.    T5 := T5 - 1;
  728.    WRITE(T5:2, '|');
  729.    FOR I := 0 TO 23 DO WRITE(' ', Plot[I,T5]);
  730.    WRITELN('Sunspot Number = ', S9:3:0);
  731.  
  732.    T5 := T5 - 1;
  733.    WRITE(T5:2, '|');
  734.    FOR I := 0 TO 23 DO WRITE(' ', Plot[I,T5]);
  735.    WRITELN;
  736.  
  737.    T5 := T5 - 1;
  738.    WRITE(T5:2, '|');
  739.    FOR I := 0 TO 23 DO WRITE(' ', Plot[I,T5]);
  740.    WRITELN('From: ', COPY(Tstr, 1, 22));
  741.  
  742.    T5 := T5 - 1;
  743.    WRITE(T5:2, '|');
  744.    FOR I := 0 TO 23 DO WRITE(' ', Plot[I,T5]);
  745.    WRITELN('      Lat: ', TLat:3:0, ' Lon: ',TLon:4:0);
  746.  
  747.  
  748.    T5 := T5 - 1;
  749.    WRITE(T5:2, '|');
  750.    FOR I := 0 TO 23 DO WRITE(' ', Plot[I,T5]);
  751.    WRITELN('To: ', COPY(Rstr, 1, 24));
  752.  
  753.    T5 := T5 - 1;
  754.    WRITE(T5:2, '|');
  755.    FOR I := 0 TO 23 DO WRITE(' ', Plot[I,T5]);
  756.    WRITELN('      Lat: ', RLat:3:0, ' Lon: ', RLon:4:0);
  757.  
  758.    T5 := T5 - 1;
  759.    WRITE(T5:2, '|');
  760.    FOR I := 0 TO 23 DO WRITE(' ', Plot[I,T5]);
  761.    WRITELN;
  762.  
  763.    T5 := T5 - 1;
  764.    WRITE(T5:2, '|');
  765.    FOR I := 0 TO 23 DO WRITE(' ', Plot[I,T5]);
  766.    WRITELN('   UTC    MUF   UTC    MUF');
  767.  
  768.    FOR T5 := MaxMuf-10 DOWNTO MinMuf DO
  769.       BEGIN
  770.       T1 := (MaxMuf-10) - T5;
  771.       T2 := T1 + 12;
  772.       WRITE(T5:2,'|');
  773.       FOR I := 0 TO 23 DO WRITE(' ',Plot[I,T5]);
  774.       WRITELN('    ',T1:2,'   ',Muf[T1]:4:1,'    ',T2:2,'   ',Muf[T2]:4:1);
  775.       END;  {T5 := MaxMuf-10 DOWNTO MinMuf-12}
  776.  
  777.    END;
  778.  
  779.  
  780. PROCEDURE PrintGraphHeader;
  781.    BEGIN
  782.    WRITELN('      1   3   5   7   9  11  13  15  17  19  21  23');
  783.    END;
  784.  
  785. PROCEDURE PrintGraphFooter;
  786.    BEGIN
  787.    WRITE  ('      1   3   5   7   9  11  13  15  17  19  21  23   ');
  788.    END;
  789.  
  790.  
  791. PROCEDURE ClearPlotArray;
  792.    BEGIN
  793.    {Initialize plotting array to blanks}
  794.    FOR I := 0 TO 23 DO
  795.       BEGIN
  796.       FOR T5 := (MinMuf+1) TO (MaxMuf-1) DO Plot[I,T5] := ' ';
  797.       END;
  798.    FOR I := 0 TO 23 DO
  799.       BEGIN
  800.       Plot[I,MinMuf] := '=';
  801.       Plot[I,MaxMuf] := '=';
  802.       Plot[I,14] := '-';
  803.       Plot[I,21] := '-';
  804.       END;
  805.  
  806.    END;
  807.  
  808.  
  809.  
  810.  
  811. {MAIN PROGRAM}
  812. BEGIN
  813. Initialize;
  814. ReadSetupFileData;
  815. IF not SetupFileError then
  816.    BEGIN
  817.       CSstr := StationCall;
  818.       REPEAT
  819.       BEGIN
  820.          REPEAT
  821.             PrintScreenHeader;
  822.             DisplayOptionMenu;
  823.             ClearPlotArray;
  824.             WRITE ('CHOICE? ');
  825.             READLN (Ch);
  826.             IF (Ch<1) OR (Ch>17) THEN
  827.             BEGIN
  828.                CLRSCR;
  829.                GOTOXY(30,12);
  830.                WRITELN ('BAD CHOICE NUMBER',^G);
  831.                DELAY (500);
  832.                END;
  833.          UNTIL (Ch>=1) AND (Ch<=17);
  834.  
  835.          {If this is the first time through, then get date and sunspot info}
  836.          {If this is the first time, AN1str='*' from Initialize}
  837.          {If we have been through before, AN1str = S,s,F,f from SunSpotData}
  838.          IF AN1str='*' THEN
  839.             BEGIN
  840.             CLRSCR;
  841.             PrintScreenHeader;
  842.             GetDayMonth;
  843.             SunSpotData;
  844.             ThresholdFlag;
  845.             END;
  846.  
  847.          GetLatitudeLongitude;
  848.  
  849.          CLRSCR;
  850.          PrintScreenHeader;
  851.          GOTOXY(25,12);
  852.          WRITE('Calculating the MUF for **00z');
  853.  
  854.          L1 := L1 * R0;
  855.          W1 := W1 * R0;
  856.          L2 := L2 * R0;
  857.          W2 := W2 * R0;
  858.          FOR T5 := 0 TO 23 DO
  859.             BEGIN
  860.             GOTOXY(49,12);
  861.             WRITE(T5:2);
  862.             MinimufCalcLoop;
  863.             IF TA = 0 THEN Dstr := '*';
  864.             IF TA = 1 THEN
  865.                BEGIN
  866.                IF J9 >= Tam THEN Dstr := '*'
  867.                ELSE Dstr := '.'
  868.                END;
  869.             I := ROUND(J9);
  870.  
  871.             {Set a  floor of <MinMuf>MHz and a ceiling of <MaxMuf>MHz for the plot}
  872.             IF I < MinMuf THEN
  873.                BEGIN
  874.                I := MinMuf;
  875.                Dstr := '@';
  876.                END;
  877.             IF I > MaxMuf THEN
  878.                BEGIN
  879.                I := MaxMuf;
  880.                Dstr := '@';
  881.                END;
  882.  
  883.             Muf[T5] := J9;
  884.             Plot[T5,I] := Dstr;
  885.             END;  {T5 := 0 TO 23}
  886.  
  887.          CLRSCR;
  888.          PrintGraphHeader;
  889.          DataPrint;
  890.          PrintGraphFooter;
  891.          XPos := WhereX;
  892.          YPos := WhereY;
  893.          HardCopyFlag;
  894.          IF LP = 1 THEN
  895.             BEGIN
  896.             HardCopyHeader;
  897.             HardCopyDataPrint;
  898.             HardCopyFooter;
  899.             END;
  900.  
  901.          GOTOXY(XPos,YPos);
  902.          CLREOL;
  903.          TEXTBACKGROUND(LightGray);
  904.          TEXTCOLOR(Black);
  905.          WRITE ('Plot another (Y/N)?', ^G, ^G, ^G);
  906.          TEXTBACKGROUND(Black);
  907.          TEXTCOLOR(LightGray);
  908.          WRITE (' ');
  909.          READLN (ANstr);
  910.          END;   {Repeat Main Loop}
  911.       UNTIL (ANstr IN No);
  912.    END;  {If there is no SetupFileError}
  913. END.